home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / batchut / batmakr2.zip / BATMAKER.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-14  |  15KB  |  393 lines
  1.  
  2.  
  3.  
  4. program BATMAKER;
  5.  
  6. {------------------------------------------------------------------------------
  7.      BATMAKER version 2.00  R.L. Miller
  8.  
  9.      Program to read file names from a disk directory, and put them into a
  10.   batch file called NAMES.BAT.  Several formats are supported: see accompanying
  11.   file, BATMAKER.DOC.
  12.  
  13.      >>> Turbo Database Toolbox needed to compile this program. <<<
  14.  
  15.      BATMAKER uses MSDos to get file names from an IBM formated diskette.
  16.   The function calls used can be found in the DOS Technical Reference Manual.
  17.   This program uses the current Data Transfer Area ( DTA ) in the variables
  18.   DTAseg and DTAofs.
  19.  
  20. ------------------------------------------------------------------------------}
  21. {$I-,U+,C+,V-}
  22.  
  23. const
  24.   Scrful  =  20;
  25.  
  26.  
  27. type                            { TYPE declarations }
  28.   Registers =
  29.     record           { register pack used in MSDos call }
  30.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  31.     end;
  32.   Char80arr     = array [ 1..80 ] of Char;
  33.   String80      = string[ 80 ];
  34.   BigString     = string[255];
  35.   CommandString = string[127];
  36.   sptr          = ^BigString;
  37.  
  38. var                              { VARIABLE declarations }
  39.   DTA : array [ 1..43 ] of Byte;       { Data Transfer Area Buffer }
  40.   DTAseg,                              { DTA Segment before exicution }
  41.   DTAofs,                              { DTA Offset    "        "     }
  42.   SetDTAseg,                           { DTA Segment and Offset set after }
  43.   SetDTAofs,                           { start of program }
  44.   Error,                               { Error return }
  45.   I, J,                                { used as counters }
  46.   Option : Integer;                    { used to specify file types }
  47.   Regs : registers;                    { register pack for the DOS call }
  48.   Buffer,                              { generic Buffer }
  49.   Fname : String80;                     { file name }
  50.   Afn : Char80arr;                    { file Mask: "Ambiguous File Name" }
  51.   Lines : Integer;                     { no. lines on screen already }
  52.   Status: Integer;                     { Status number returned by TurboSort }
  53.   ComLine : CommandString;             { COPY of invoking Command line, for parsing}
  54.   CL      : CommandString absolute CSEG:$80;  {ACTUAL command line string }
  55.   OutFile : text;                      { File handle for NAMES.BAT, the output file}
  56.   Opt     : string[3];                 {Option string}
  57.  
  58.  Delim                             :  string[20];
  59.  FirstWord,NextWord,NewWord        :  string[80];
  60.  FlagWords                         :  string[255];
  61.  start, next                       :    integer;
  62.  strptr                            :  sptr;
  63.  
  64.  
  65. (**************************************************************************)
  66. (*                                                                        *)
  67. (*  NOTICE    NOTICE    NOTICE    NOTICE    NOTICE    NOTICE    NOTICE    *)
  68. (*                                                                        *)
  69. (*    Turbo Database Toolbox needed to compile this program!              *)
  70. (*                                                                        *)
  71. (**************************************************************************)
  72.  
  73. {$ISORT.BOX}
  74.  
  75.  
  76. {-----------------------------------------------------------------------------
  77.      SetLen: sets length of ASCIZ string passed to it as a parameter.
  78. ------------------------------------------------------------------------------}
  79. Procedure SetLen(var ST: bigstring);
  80.  
  81. Const
  82.   MAX              :   Char = #255;
  83. var
  84.   Segment,Offset   :   Integer;
  85.   Terminator       :   Integer;
  86.   Null             :   String[2];
  87.  
  88. Begin
  89.   Null := #0;
  90.   ST[0] := MAX;   { Initially set length to Max }
  91.   Terminator := Pos(null,ST) - 1;
  92.   ST[0] := Chr(Lo(Terminator));
  93. end;  {of proc SetLen}
  94.  
  95. {----------------------------------------------------------------------------
  96.      PrtPath: prints out full path string (including drive name).
  97. -----------------------------------------------------------------------------}
  98. Procedure PrtPath;
  99.  
  100. Const
  101.    Carry = $0001;
  102.  
  103. Var
  104.    Disk  :   String[4];
  105.    Path  :   String[80];
  106.    Ichar :   Integer;
  107.    Pathseg,Pathofs : integer;
  108.  
  109. Begin
  110.   Regs.AX := $1900;  { Set up for "Current Disk" DOS call }
  111.   MSDOS( Regs);
  112.   Ichar := Lo(Regs.AX) + $41;
  113.   Disk := Chr(Ichar);
  114.   Disk := Disk + ':';
  115.   { Now set up for "Return Text of Current Directory" DOS call }
  116.   Regs.DX := 0;
  117.   Regs.AX := $4700;
  118.   Regs.DS := Seg(path);
  119.   Regs.SI := ofs(Path) + 1;
  120.   Pathseg := Regs.DS;
  121.   Pathofs := Regs.SI;
  122.   MSDOS( Regs);
  123.   Error := Regs.Flags and Carry;
  124.     {$V-}
  125.   Setlen(Path);  { Turn path string into something familiar to Turbo }
  126.   Writeln(' Reading Directory of: ',Disk+Buffer);
  127.   Writeln('  (Current directory is: ',Disk+'\'+Path,')');
  128.   Writeln;
  129. End;  {of proc PrtPath}
  130.  
  131.  
  132. {------------------------------------------------------------------------------
  133.      GetDTA is used to get the current Disk Transfer Area ( DTA )
  134. address.  A function code of $2F is stored in the high Byte of the AX
  135. register and a call to the  MSDos INT 21H is made, by using the "Intr"
  136. procedure with a $21 specification for the interrupt.
  137. ------------------------------------------------------------------------------}
  138.  
  139. procedure GetDTA( var Segment, Offset : Integer;
  140.                          var Error : Integer );
  141. begin
  142.   Regs.AX := $2F00;    { Function used to get current DTA address }
  143.                        { $2F00 is used instead of $2F shl 8 to save
  144.                          three assembly instructions.  An idea for
  145.                          optimization. }
  146.   Intr( $21, Regs );       { Execute MSDos function request }
  147.   Segment := Regs.ES;  { Segment of DTA returned by DOS }
  148.   Offset := Regs.BX;   { Offset of DTA returned }
  149.   Error := Regs.AX and $FF;
  150. end; { of proc GetDTA }
  151.  
  152. {------------------------------------------------------------------------------
  153.      GetFirst gets the first directory entry of a particular file Mask.  The
  154. Afn is passed as a parameter 'Afn' and,  the Option was previosly specified
  155. in the SpecifyOption procedure.
  156. ------------------------------------------------------------------------------}
  157.  
  158. procedure GetFirst( Afn : Char80arr; var Fname : String80;
  159.                     Segment, Offset : Integer; Option : Integer;
  160.                     var Error : Integer );
  161. var
  162.   I : Integer;
  163. begin
  164.   Error := 0;
  165.   Regs.AX := $4E00;          { Get first directory entry }
  166.   Regs.DS := Seg( Afn );    { Point to the file Mask }
  167.   Regs.DX := Ofs( Afn );
  168.   Regs.CX := Option;         { Store the Option }
  169.   MSDos( Regs );             { Execute MSDos call }
  170.   Error := Regs.AX and $FF;  { Get Error return }
  171.   strptr := ptr(segment, offset+29);
  172.   setlen( strptr^);
  173.   Fname := strptr^;
  174. end; { of proc GetFirst }
  175.  
  176. {------------------------------------------------------------------------------
  177.      GetNext uses the first bytes of the DTA for the file Mask, and
  178. returns the next file entry on disk corresponding to the file Mask.
  179. ------------------------------------------------------------------------------}
  180.  
  181. procedure GetNext( var Fname : String80; Segment, Offset : Integer;
  182.                         Option : Integer; var Error : Integer );
  183. var
  184.   I : Integer;
  185.  
  186. begin
  187.   Error := 0;
  188.   Regs.AX := $4F00;           { Function used to get the next }
  189.                               { directory entry }
  190.   Regs.CX := Option;          { Set the file option }
  191.   MSDos( Regs );              { Call MSDos }
  192.   Error := Regs.AX and $FF;   { get the Error return }
  193.   strptr := ptr(segment, offset+29);
  194.   setlen( strptr^);
  195.   Fname := strptr^;
  196. end; { of proc GetNext }
  197.  
  198. {===========================================================================
  199.   ABORT procedure: Prints out help message & halts program
  200. =============================================================================}
  201.  
  202. Procedure Abort;
  203.  
  204. begin
  205.   WriteLn('Usage: BATMAKER Filename.Typ -O)ption_Letter');
  206.   Writeln;
  207.   Writeln('Option_Letter  Output                              ');
  208.   Writeln('=============